home *** CD-ROM | disk | FTP | other *** search
/ Micromanía 93 / CDMM_93_2.ISO / Project Nomads / nomads_demo_eng.exe / NSH.TCL < prev    next >
Encoding:
Text File  |  2002-02-19  |  8.3 KB  |  366 lines
  1. #!/bin/sh
  2. #
  3. #    /nomads/bin/nsh.tcl
  4. #
  5. #    Stellt verschiedene Standard-Tools und Spracherweiterungen 
  6. #    fⁿr die NebulaSHell und fⁿr die Standard-Nebula-Scripts
  7. #    zur Verfⁿgung.
  8. #    Mit nsh_help bekommt eine ▄bersicht ⁿber die implementierten Befehle.
  9. #
  10. #   *** ACHTUNG !!! Alle DEMO-spezifischen Befehle habe ich 
  11. #   nach /nomads/scripts/commands.tcl
  12. #   verlegt. (Flieger, Samml, etc.)
  13. #
  14. #
  15. #    created:    Okt-1998
  16. #    upd.:        25-May-99
  17. #               21-Jun-99   floh    "<error>" durch "null" ersetzt
  18. #               22-Jun-99   bernd   Help gekillt
  19. #               15-Feb-00   floh    + new proc get_platform()
  20. #
  21. #    (c) 1998-1999 Bernd Beyreuther
  22. #
  23.  
  24.  
  25.  
  26. # set         home                $env(NOMADS_HOME)
  27. # source      $home/bin/assigns.tcl
  28.  
  29.  
  30. # -------------------------------------------------------------------
  31. proc screen {} {
  32.     set bildname                "shot.bmp"
  33.     /sys/servers/gfx.screenshot $bildname
  34. return
  35. }
  36.  
  37.  
  38. #--------------------------------------------------------------------
  39. #   get_platform()
  40. #   Detect platform and return one of the following strings:
  41. #   win9x   -> Windows 95 and 98
  42. #   winnt   -> Windows NT 4
  43. #   win2k   -> Windows 2000
  44. #   unix    -> Unix variant
  45. #   unknown -> unknown
  46. #--------------------------------------------------------------------
  47. proc get_platform {} {
  48.     global tcl_platform
  49.     set p "unknown"
  50.     if {$tcl_platform(platform) == "windows"} {
  51.         if {$tcl_platform(os) == "Windows NT"} {
  52.             if {$tcl_platform(osVersion) >= 5.0} {
  53.                 set p "win2k"
  54.                 puts "Windows 2000 detected"
  55.             } else {
  56.                 set p "winnt"
  57.                 puts "Windows NT detected"
  58.             }
  59.         } else {
  60.             set p "win9x"
  61.             puts "Windows9x detected"
  62.         }
  63.     } elseif {$tcl_platform(platform) == "unix"} {
  64.         set p "unix"
  65.         puts "Unix detected"
  66.     } else {
  67.         set p "unknown"
  68.         puts "Unknown platform detected"
  69.     }
  70.     return $p
  71. }
  72.  
  73. # -------------------------------------------------------------------
  74. proc st {} {
  75.     sel /usr/scene/std
  76. return
  77. }
  78.  
  79. # -------------------------------------------------------------------
  80. proc sc {} {
  81.     sel /usr/scene
  82. return
  83. }
  84.  
  85. # -------------------------------------------------------------------
  86. proc roty {} {
  87.     catch { delete roty  } err
  88.     catch { delete roty2 } err
  89.     new nipol roty
  90.         sel roty
  91.         .connect ry
  92.         .addkey1f 0 0
  93.         .addkey1f 3 360
  94.     sel ..
  95. return
  96. }
  97.  
  98.  
  99. # -------------------------------------------------------------------
  100. proc animtz {} {
  101.     new nipol tz
  102.         sel tz
  103.         .connect tz
  104.         .addkey1f 0 0
  105.         .addkey1f 5 -1500
  106.     sel ..
  107. return
  108. }
  109.  
  110.  
  111. # -------------------------------------------------------------------
  112. proc roty2 {} {
  113.     catch { delete roty  } err
  114.     catch { delete roty2 } err
  115.     new nipol roty2
  116.         sel roty2
  117.         .connect ry
  118.         .addkey1f 0 360
  119.         .addkey1f 3 0
  120.     sel ..
  121. return
  122. }
  123.  
  124. # -------------------------------------------------------------------
  125. proc rotx {} {
  126.     new nipol rotx
  127.         sel rotx
  128.         .connect rx
  129.         .addkey1f 0 0
  130.         .addkey1f 5 360
  131.     sel ..
  132. return
  133. }
  134.  
  135. # -------------------------------------------------------------------
  136. proc rotz {} {
  137.     new nipol rotz
  138.         sel rotz
  139.         .connect rz
  140.         .addkey1f 0 0
  141.         .addkey1f 5 360
  142.     sel ..
  143. return
  144. }
  145.  
  146. # -------------------------------------------------------------------
  147. proc stop {} {
  148.     catch { delete rotx  } err
  149.     catch { delete roty  } err
  150.     catch { delete roty2 } err
  151.     catch { delete rotz  } err
  152.     .rxyz 0 0 0
  153. return
  154. }
  155.  
  156. # -------------------------------------------------------------------
  157. proc gfx {} {
  158.     connect gfxserv
  159.     sel /
  160. return
  161. }
  162.  
  163. # -------------------------------------------------------------------
  164. proc l {} {
  165.     sel /
  166.     sel usr
  167.     sel scene
  168.     sel dlight
  169. return
  170. }
  171.  
  172. # -------------------------------------------------------------------
  173. proc ndir {} {
  174.     set cur_dir [psel]
  175.     set result ""
  176.     set x [.gethead]
  177.     while {$x != "null"} {
  178.         sel $x
  179.         lappend result [.getname]
  180.         set x [.getsucc]
  181.     }
  182.     sel $cur_dir
  183. return $result
  184. }
  185.  
  186. # -------------------------------------------------------------------
  187. proc new_objects {class name number} {
  188.     for {set i 0} {$i < $number} {incr i 1} {
  189.         new $class $name$i
  190.     }
  191. return
  192. }
  193.  
  194. # -------------------------------------------------------------------
  195. proc ndir2 {} {
  196.     set dirinhalt [ndir]
  197.     foreach eintrag $dirinhalt {
  198.         puts stdout $eintrag
  199.     }
  200. return
  201. }
  202.  
  203. # -------------------------------------------------------------------
  204. global treecount    
  205. set    treecount 0
  206. proc tree {} {
  207.     global treecount    
  208.     set cur_dir [psel]
  209.     set result ""
  210.     set x [.gethead]
  211.     while {$x != "null"} {
  212.         sel $x
  213.         puts stdout  [.getfullname]
  214.         incr treecount 1
  215.         tree        
  216.         set x [.getsucc]
  217.     }
  218.     sel  $cur_dir
  219. return
  220. }
  221.  
  222. # -------------------------------------------------------------------
  223. #   NOMADS DEBUG CODE
  224. #   ANALYZE SIND ZWEI DEBUG / PROFILE ROUTINEN um den data.n
  225. #   Nebula Objekt Tree sich mal anzugucken.
  226. # -------------------------------------------------------------------
  227. set globalcount 0
  228. set objectcount 0
  229.  
  230. proc analyzefull {} {
  231.     global globalcount
  232.     global objectcount    
  233.     set cur_dir     [psel]
  234.     set result      ""
  235.     set x           [.gethead]
  236.     while {$x != "null"} {
  237.         sel     $x
  238.         incr globalcount 1   
  239.         incr objectcount 1           
  240.         analyzefull        
  241.         set     x       [.getsucc]
  242.     }
  243.     sel  $cur_dir
  244. return
  245. }
  246.  
  247. proc analyzeobject {} {
  248.     global globalcount
  249.     global objectcount
  250.     set objectcount 0
  251.     
  252.     set cur_dir     [psel]
  253.     set result      ""
  254.     set x           [.gethead]
  255.     while {$x != "null"} {
  256.         sel     $x
  257.         incr globalcount 1    
  258.         incr objectcount 1            
  259. #        puts    stdout  [.getfullname]  
  260.         analyzefull        
  261.         set     x       [.getsucc]
  262.     }
  263.     sel  $cur_dir
  264.     puts $objectcount
  265. return
  266. }
  267.  
  268.  
  269. proc data {} {
  270.     cd  c:/nomads
  271.     /sys/servers/file.setassign   lib     c:/nomads/data.n/lib/
  272.     /sys/servers/file.setassign   data    c:/nomads/data.n/
  273.     get data.n
  274.     sel data
  275. }
  276.  
  277. proc analyze {} {
  278.  
  279.     global globalcount
  280.     set globalcount 0
  281.     
  282.     set cur_dir     [psel]
  283.     set result      ""
  284.     set x           [.gethead]
  285.     while {$x != "null"} {
  286.         sel     $x
  287.         puts    stdout "[.getfullname] :  " nonewline
  288.         flush   stdout
  289.         incr globalcount 1
  290.         analyzeobject        
  291.         set     x       [.getsucc]
  292.     }
  293.     sel  $cur_dir
  294.     puts $globalcount
  295.     puts $objectcount
  296. return
  297. }
  298.  
  299. # -------------------------------------------------------------------
  300.  
  301. # -------------------------------------------------------------------
  302. proc licht {} {
  303. global home
  304.     set current [getfullname]
  305.     sel /usr/scene/dlight/light1
  306.     if {[ .getactive ] == "true"} {
  307.         puts stdout "licht aus"
  308.         .setactive false
  309.         sel /usr/scene/dlight/light2
  310.         .setactive false
  311.     } else {
  312.         puts stdout "- LICHT AN -"
  313.         .setactive true
  314.         sel /usr/scene/dlight/light2
  315.         .setactive true
  316.     }
  317.     sel $current
  318. return
  319. }
  320.  
  321. # -------------------------------------------------------------------
  322. proc  zeit {} {
  323.     set current [getfullname]
  324.     sel /sys/servers/time
  325.  
  326.     # ask two times with a break (!), because otherwise gettime will
  327.     # return same value on fast machines
  328.     set time1 [.gettime]
  329.     after 10
  330.     set time2 [.gettime]
  331.     if  {$time1 == $time2} {
  332.         .starttime
  333.     } else {
  334.         .stoptime
  335.     }
  336.     sel $current
  337. return
  338. }
  339.  
  340. # -------------------------------------------------------------------
  341. proc viewlod {} {
  342.     /sys/servers/console.watch sg*
  343. return    
  344. }
  345.  
  346. # -------------------------------------------------------------------
  347. proc init_loddisp {} {
  348.     new nenv       /sys/var/sg_lod
  349.     refresh_loddisp
  350. return    
  351. }
  352.  
  353. # -------------------------------------------------------------------
  354. #   13-Nov-00   floh    standard-vbuf Name jetzt 'mesh'
  355. #
  356. # -------------------------------------------------------------------
  357. proc refresh_loddisp {} {
  358.     set obj ""
  359.  
  360.     if {[exists /usr/scene/std]} {
  361. #        /sys/var/sg_lod.setf [ /usr/scene/std.getcurrentlod ]
  362. #        after 100 refresh_loddisp
  363.     }
  364. }
  365.  
  366.